home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / playin_1 / pong.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-17  |  13.1 KB  |  307 lines
  1. VERSION 5.00
  2. Begin VB.Form Pong 
  3.    Caption         =   "Pong"
  4.    ClientHeight    =   7320
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   6090
  8.    KeyPreview      =   -1  'True
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   488
  13.    ScaleMode       =   3  'Pixel
  14.    ScaleWidth      =   406
  15.    StartUpPosition =   1  'CenterOwner
  16.    Begin VB.Timer Timer1 
  17.       Interval        =   1
  18.       Left            =   180
  19.       Top             =   6840
  20.    End
  21.    Begin VB.PictureBox PlayField 
  22.       AutoRedraw      =   -1  'True
  23.       BackColor       =   &H00008000&
  24.       Height          =   7215
  25.       Left            =   840
  26.       ScaleHeight     =   477
  27.       ScaleMode       =   3  'Pixel
  28.       ScaleWidth      =   289
  29.       TabIndex        =   0
  30.       Top             =   60
  31.       Width           =   4395
  32.       Begin VB.PictureBox RightShadow 
  33.          Appearance      =   0  'Flat
  34.          AutoRedraw      =   -1  'True
  35.          AutoSize        =   -1  'True
  36.          BackColor       =   &H00004000&
  37.          BorderStyle     =   0  'None
  38.          ForeColor       =   &H80000001&
  39.          Height          =   480
  40.          Left            =   840
  41.          Picture         =   "Pong.frx":0000
  42.          ScaleHeight     =   32
  43.          ScaleMode       =   3  'Pixel
  44.          ScaleWidth      =   8
  45.          TabIndex        =   5
  46.          Top             =   240
  47.          Visible         =   0   'False
  48.          Width           =   120
  49.       End
  50.       Begin VB.PictureBox LeftShadow 
  51.          Appearance      =   0  'Flat
  52.          AutoRedraw      =   -1  'True
  53.          AutoSize        =   -1  'True
  54.          BackColor       =   &H00004000&
  55.          BorderStyle     =   0  'None
  56.          ForeColor       =   &H80000001&
  57.          Height          =   480
  58.          Left            =   480
  59.          Picture         =   "Pong.frx":0342
  60.          ScaleHeight     =   32
  61.          ScaleMode       =   3  'Pixel
  62.          ScaleWidth      =   16
  63.          TabIndex        =   4
  64.          Top             =   240
  65.          Visible         =   0   'False
  66.          Width           =   240
  67.       End
  68.       Begin VB.PictureBox WallTile 
  69.          Appearance      =   0  'Flat
  70.          AutoRedraw      =   -1  'True
  71.          AutoSize        =   -1  'True
  72.          BackColor       =   &H80000005&
  73.          BorderStyle     =   0  'None
  74.          ForeColor       =   &H80000008&
  75.          Height          =   480
  76.          Left            =   0
  77.          Picture         =   "Pong.frx":0984
  78.          ScaleHeight     =   32
  79.          ScaleMode       =   3  'Pixel
  80.          ScaleWidth      =   32
  81.          TabIndex        =   3
  82.          Top             =   240
  83.          Visible         =   0   'False
  84.          Width           =   480
  85.       End
  86.       Begin VB.PictureBox Bats 
  87.          Appearance      =   0  'Flat
  88.          AutoRedraw      =   -1  'True
  89.          AutoSize        =   -1  'True
  90.          BackColor       =   &H80000005&
  91.          BorderStyle     =   0  'None
  92.          ForeColor       =   &H80000008&
  93.          Height          =   240
  94.          Left            =   540
  95.          Picture         =   "Pong.frx":15C6
  96.          ScaleHeight     =   16
  97.          ScaleMode       =   3  'Pixel
  98.          ScaleWidth      =   48
  99.          TabIndex        =   2
  100.          Top             =   0
  101.          Visible         =   0   'False
  102.          Width           =   720
  103.       End
  104.       Begin VB.PictureBox Balls 
  105.          Appearance      =   0  'Flat
  106.          AutoRedraw      =   -1  'True
  107.          AutoSize        =   -1  'True
  108.          BackColor       =   &H80000005&
  109.          BorderStyle     =   0  'None
  110.          ForeColor       =   &H80000008&
  111.          Height          =   240
  112.          Left            =   0
  113.          Picture         =   "Pong.frx":1F0A
  114.          ScaleHeight     =   16
  115.          ScaleMode       =   3  'Pixel
  116.          ScaleWidth      =   32
  117.          TabIndex        =   1
  118.          Top             =   0
  119.          Visible         =   0   'False
  120.          Width           =   480
  121.       End
  122.    End
  123. Attribute VB_Name = "Pong"
  124. Attribute VB_GlobalNameSpace = False
  125. Attribute VB_Creatable = False
  126. Attribute VB_PredeclaredId = True
  127. Attribute VB_Exposed = False
  128. Option Explicit
  129. ' Copyright Derek Hall 18/8/1999
  130. ' derek.hall@virgin.net
  131. ' Your rights
  132. ' You may re-distribute this code
  133. ' You may not charge for it
  134. ' You may alter the code for your own use
  135. ' You may learn from it, I hope....
  136. ' as for the graphics (By me) you can use them in whatever you want.
  137. ' Instructions
  138. ' Best viewed in 1024x768 mode to read text.
  139. ' Best Played in 800x600 for speed without internet connection.
  140. ' try with connection and whatch speed..
  141. ' Try to rescale the form.
  142. 'Hint 1
  143. 'Using a timer is not the best way to get speed... But I have here for simple instructions
  144. 'Hint 2
  145. 'For more speed
  146. ' Use a loop with a doevents init at the maximum loop point
  147. ' so you can get the processor hold ups to a minimum.
  148. 'if doevents is at the minimum point in the loop then there
  149. 'will be more for the processor to do each time it gets to doevents
  150. ' so that is why games have jurky movements.
  151. 'give the processor all the time you can when multi tasking
  152. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  153.   If KeyCode = 39 Then
  154.     Bat(Human).Speed = ConstBatSpeed ' while key down make human player speed to constant speed
  155.   ElseIf KeyCode = 37 Then
  156.    Bat(Human).Speed = -(ConstBatSpeed) ' while key down make human player speed to minus the constant speed
  157.   End If
  158. End Sub
  159. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  160.   Bat(Human).Speed = 0 ' set this so that the bat does not move while keys are up
  161. End Sub
  162. Private Sub Form_Load()
  163.   SetUPData  'goto sub
  164.   Reset 'goto sub
  165. End Sub
  166. Private Sub printScore()
  167.   'putscore in titlebar
  168.   Me.Caption = "Pong   " & player(Computer).Name & ":" & player(Computer).Score & "     " & player(Human).Name & ":" & player(Human).Score & "  " & "Try to rescale form"
  169. End Sub
  170. Private Sub Form_Resize()
  171.   'if form window state is max or min then reset to normal
  172.   If Pong.WindowState = 1 Or Pong.WindowState = 2 Then Pong.WindowState = 0
  173.   'Calculate the blocks so the screen can be resized b 32 pixel blocks
  174.   If Pong.Width < (Tilesize * 15) * 5 Then Pong.Width = (Tilesize * 15) * 7
  175.   If Pong.Height < (Tilesize * 15) * 5 Then Pong.Height = (Tilesize * 15) * 9
  176.   'set map.DivideByX
  177.   Map.DivideByX = Int(Pong.Width / (32 * 15)) 'Divide form size by 32 pixels, Remember it is in Twips.
  178.   Pong.Width = (32 * 15) * Map.DivideByX  ' now make the form width resize to the nearest 32 pixels
  179.   'set map.DivideByY
  180.   Map.DivideByY = Int(Pong.Height / (32 * 15)) 'Divide form size by 32 pixels, Remember it is in Twips.
  181.   Pong.Height = (32 * 15) * Map.DivideByY  ' now make the form width resize to the nearest 32 pixels
  182.   PlayField.Top = 2 'set the picturebox Called Playfield Top
  183.   PlayField.Left = 2 'set the picturebox Called Playfield Left
  184.   PlayField.Width = (Pong.Width / 15) - 10 'set the picturebox Called Playfield Width
  185.   PlayField.Height = (Pong.Height / 15) - 28 'set the picturebox Called Playfield Height
  186.   Reset ' goto sub
  187. End Sub
  188. Sub Reset()
  189.   Bat(Human).PositionY = PlayField.Height - 28
  190.   Bat(Computer).PositionX = Int(PlayField.ScaleWidth / 2) - (Bats.Width / 2)
  191.   Bat(Human).PositionX = Bat(Computer).PositionX
  192.   'Set the balls X at random start in the middle of the playfield
  193.   Ball.PositionX = ((200 * Rnd) - 100) + Int(PlayField.ScaleWidth / 2) - (Balls.Width / 2)
  194.   'Set the balls Y in the middle of the playfield
  195.   Ball.PositionY = Int(PlayField.ScaleHeight / 2) - (Balls.Height / 2)
  196.   printScore ' goto sub
  197. End Sub
  198. Private Sub Timer1_Timer()
  199.   Drawmap 'Goto Sub
  200. End Sub
  201. Private Sub Drawmap()
  202.   Dim i As Integer
  203.   PlayField = LoadPicture ' Clear the PlayField
  204.   For i = 0 To Map.DivideByY
  205.     'Draw left side wall
  206.     BitBlt PlayField.hDC, 0, i * Tilesize, Tilesize, Tilesize, WallTile.hDC, 0, 0, SRCCOPY
  207.     'Draw left side wall Shadow
  208.     BitBlt PlayField.hDC, Tilesize, i * Tilesize, 16, Tilesize, LeftShadow.hDC, 0, 0, SRCCOPY
  209.     'Draw right side wall Shadow
  210.     BitBlt PlayField.hDC, PlayField.Width - (Tilesize + 12), i * Tilesize, 8, 32, RightShadow.hDC, 0, 0, SRCCOPY
  211.      'Draw left side wall
  212.     BitBlt PlayField.hDC, PlayField.Width - (Tilesize + 5), i * Tilesize, Tilesize, Tilesize, WallTile.hDC, 0, 0, SRCCOPY
  213.   Next i
  214.   GetBatPositions 'goto sub and calculate bat positions
  215.   'OK now we draw the bats shadows using a mask but not using SRCPAINT to fill it in
  216.   BitBlt PlayField.hDC, Bat(Computer).PositionX + 4, Bat(Computer).PositionY + 4, 48, 16, Bats.hDC, 0, 0, SRCAND
  217.   BitBlt PlayField.hDC, Bat(Human).PositionX + 4, Bat(Human).PositionY + 4, 48, 16, Bats.hDC, 0, 0, SRCAND
  218.   'OK now we draw the bats no masks needed as they are Rectangles
  219.   BitBlt PlayField.hDC, Bat(Computer).PositionX, Bat(Computer).PositionY, 48, 16, Bats.hDC, 0, 0, SRCCOPY
  220.   BitBlt PlayField.hDC, Bat(Human).PositionX, Bat(Human).PositionY, 48, 16, Bats.hDC, 0, 0, SRCCOPY
  221.   GetBallPositions 'goto sub and calculate ball positions
  222.   'Then the draw ball shadow using a mask but not using SRCPAINT to fill it in
  223.   BitBlt PlayField.hDC, Ball.PositionX + Ball.Height, Ball.PositionY + Ball.Height, 16, 16, Balls.hDC, 0, 0, SRCAND 'mask
  224.   'Then Mask out the ball
  225.   BitBlt PlayField.hDC, Ball.PositionX, Ball.PositionY, 16, 16, Balls.hDC, 0, 0, SRCAND 'mask
  226.   'then blit it using SRCPAINT
  227.   BitBlt PlayField.hDC, Ball.PositionX, Ball.PositionY, 16, 16, Balls.hDC, 16, 0, SRCPAINT 'onto mask
  228.   ' only check if you hit the bat if you are in range of it,
  229.   ' this will save you processor time if you do not check all the other code
  230.   If Ball.PositionY < (Bat(Computer).PositionY + Bats.ScaleHeight) Or Ball.PositionY > (Bat(Human).PositionY - (Bats.ScaleHeight)) Then CheckHitABat
  231.   PlayField.Refresh  'refresh draws to the Playfield.image so you can see it, make sure auto redraw is true
  232. End Sub
  233. Sub GetBallPositions()
  234.   'first add to new position
  235.   Ball.PositionX = Ball.PositionX + Ball.SpeedX
  236.   Ball.PositionY = Ball.PositionY + Ball.SpeedY
  237.   'what direction is the ball going, true= south, false=north
  238.   ' this is for the ball shadow so that when it goes the other direction it still falls or goes up in the air
  239.   If Ball.Height > 16 Or Ball.Height < 1 Then Ball.GoingUpOrDown = Not Ball.GoingUpOrDown
  240.   If Ball.GoingUpOrDown Then
  241.     Ball.Height = Ball.Height + 1  'shadow Offset
  242.   Else
  243.     Ball.Height = Ball.Height - 1 'shadow Offset
  244.   End If
  245.   'Is ball out of play, beyond the walls?
  246.   'Left wall
  247.   If Ball.PositionX > PlayField.ScaleWidth - 56 Then
  248.     HitWallLeft           ' goto sub
  249.     s_Playsound "HitWall" ' play sound
  250.   End If
  251.   'Right wall
  252.   If Ball.PositionX < 32 Then
  253.     HitWallRight          ' goto sub
  254.     s_Playsound "HitWall" ' play sound
  255.   End If
  256. End Sub
  257. Sub CheckHitABat()
  258.   ' first find what end of the field the ball is in,
  259.   'so we only calculate the half the calculations, and do it for the correct end.
  260.   If Ball.PositionY > (Bat(Human).PositionY - 16) Then 'players end
  261.     'Check to see if Human the ball or not
  262.     If ((Ball.PositionX > (Bat(Human).PositionX - 12)) And Ball.PositionX < (Bat(Human).PositionX + 48)) Then
  263.       HitBatSpeedChangeUp   ' goto sub
  264.       s_Playsound "HitBat"  ' play sound
  265.     Else
  266.       'Did it go past the bat
  267.       If Ball.PositionY > (Bat(Human).PositionY) Then  'computer wins a point
  268.         
  269.         player(Computer).Score = player(Computer).Score + 1
  270.          Reset      ' goto sub
  271.          printScore ' goto sub
  272.       End If
  273.     End If
  274.   Else ' computer's end
  275.     'Check to see if Computer hit the ball or not
  276.     If ((Ball.PositionX > (Bat(Computer).PositionX - 12)) And Ball.PositionX < (Bat(Computer).PositionX + 48)) Then
  277.       HitBatSpeedChangeDown ' goto sub
  278.       s_Playsound "HitBat"  ' play sound
  279.     Else
  280.       'Did it go past the bat
  281.       If Ball.PositionY < Bat(Computer).PositionY Then
  282.         'computer wins a point
  283.         player(Human).Score = player(Human).Score + 1
  284.         Reset ' goto sub
  285.         printScore ' goto sub
  286.       End If
  287.     End If
  288.   End If
  289. End Sub
  290. Sub GetBatPositions()
  291.   If (Bat(Computer).PositionX + 24) > Ball.PositionX Then
  292.     'if Computer bat is greater than balls then go left
  293.     Bat(Computer).PositionX = (Bat(Computer).PositionX) - Bat(Computer).Speed
  294.   Else
  295.     'if Computer bat is less than balls then go Right
  296.     If (Bat(Computer).PositionX + 24) < Ball.PositionX Then Bat(Computer).PositionX = (Bat(Computer).PositionX) + Bat(Computer).Speed
  297.   End If
  298.   'Make sure Computer bat is not further than the wall
  299.   If Bat(Computer).PositionX > (PlayField.Width - 88) Then Bat(Computer).PositionX = (PlayField.Width - 88)
  300.   If Bat(Computer).PositionX < 32 Then Bat(Computer).PositionX = 32
  301.   'move Human Player bat
  302.   Bat(Human).PositionX = (Bat(Human).PositionX + Bat(Human).Speed)
  303.   'Make sure Players bats are not further than the wall
  304.   If Bat(Human).PositionX > (PlayField.Width - 88) Then Bat(Human).PositionX = (PlayField.Width - 88)
  305.   If Bat(Human).PositionX < 32 Then Bat(Human).PositionX = 32
  306. End Sub
  307.